home *** CD-ROM | disk | FTP | other *** search
- /* ArchiveMsgs.rexx 1.1 14-Jun-97 by Kai Nikulainen
- **
- ** Archives messages with given string in the subject.
- **
- ** Mail your comments and bug reports to knikulai@utu.fi */
-
- options results
-
- Arc='c:lha m' /* Use this command to archive the messages */
- GroupSize=10 /* How many messages are archived in each group */
- Defpath='Work:' /* Default path for the file requester */
- AddDate='yes' /* If yes, current date is added to the default archive name */
- DeleteThem='no' /* Set to yes, if your archiver doesn't remove files and you want them*/
- /* to be deleted*/
-
- BadChars='*:/"?'
-
- gtxt='Enter search pattern for subjects?'
- gtitle='Select messages to be archived'
- gbuts='_Ok|_Exit script'
- gtags='rt_pubscrname=YAMSCREEN' /* Change here the name of the screen YAM runs */
-
- reqtxt='Do you want to archive these messages?'
- reqbuts='_Yes|_No|_Exit script'
-
- call addlib('rexxreqtools.library',0,-30,0)
-
- address 'YAM'
- 'GetFolderInfo Max' /* How many messages are there? */
- n=result
-
- 'GetFolderInfo Path' /* Where is the folder */
- fp=result
- if pos(':',fp)=0 then fp='YAM:'fp
- if right(fp,1)~='/' & right(fp,1)~=':' then fp=fp'/'
-
- 'GetFolderInfo Name' /* What's it's name */
- arcname=result
- if upper(AddDate)='YES' then arcname=arcname date()
- arcname=translate(arcname,'_',' ') /* Translate spaces to _ */
- arcname=compress(arcname,BadChars) /* Remove dangerous characters */
- arcname=rtfilerequest(DefPath,arcname,'Select archive name',,gtags)
- if arcname='' then exit
-
- 'GetMailInfo Subject'
- pattern=result
- if upper(left(pattern,3))='RE:' then pattern=strip(substr(pattern,4))
- needle=upper(rtgetstring('*'pattern'*',gtxt,gtitle,gbuts,gtags))
- if needle='' then exit
-
-
- /* Let's open a window... */
- Call Close(STDOUT)
- Call Close(STDIN)
-
- Call Open(STDOUT,'CON:1/11/600/180/ArchiveFolder.rexx Output/CLOSE/WAIT/SCREEN'scrn,'w')
- Call Pragma('*',STDOUT)
-
- counter=0
- files=''
- say 'Following messages contain the string'
- do m=0 to n-1 /* Do for all messages in folder: */
- 'SetMail' m /* Select a message */
- 'GetMailInfo File' /* Get the filename */
- file=result /* Save the filename */
- 'GetMailInfo Subject' /* Guess what it does now? */
- subj=result
- if match(needle,upper(subj)) then do /* the string was found */
- say subj
- counter=counter+1
- files=files || file || ' '
- if counter=GroupSize then call Archive
- end
-
- end /* do m */
-
- if counter>0 then call Archive
-
- Say 'All messages have been examined. You can close the window now.'
- 'MailUpdate'
- exit
-
- Archive:
- 'Request "'reqtxt'" "'reqbuts'"'
- if result=0 then exit
- if result=1 then do
- address command arc arcname files
- if upper(DeleteThem)='YES' then address command 'delete' files
- end
- counter=0
- files=''
- return
-
- Match: procedure
- parse arg pat,str
- res=0
- pat=upper(pat)
- str=upper(str)
- p1=pos('*',pat)
- if p1=0 then
- res=(pat=str)
- else do
- alku=left(pat,p1-1) /* chars before first * */
- ale=length(alku)
- p2=lastpos('*',pat)
- if left(str,ale)~=alku then
- res=0
- else
- if p1=length(pat) then
- res=1
- else do
- loppu=substr(pat,p1+1)
- p2=pos('*',loppu)
- if p2=0 then
- res=(right(str,length(loppu))=loppu)
- else do
- seur=left(loppu,p2-1)
- i=ale
- do while pos(seur,str,i+1)>0
- i=pos(seur,str,i+1)
- res=(res | Match(loppu,substr(str,i)))
- end
- end
- end /* else do */
- end
- return res
-